home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / programming / languages / obrn-a_1.5_lib.lha / oberon-a / source2.lha / Source / AmigaUtil / WbConsole.mod < prev   
Encoding:
Text File  |  1995-01-26  |  2.8 KB  |  96 lines
  1. (*************************************************************************
  2.  
  3.      $RCSfile: WbConsole.mod $
  4.   Description: Module to open a console window for programs run from the
  5.                Workbench. Ensures that the program has a standard IO
  6.                environment, with valid Input() and Output() filehandles.
  7.  
  8.    Created by: fjc (Frank Copeland)
  9.     $Revision: 3.7 $
  10.       $Author: fjc $
  11.         $Date: 1995/01/26 00:30:04 $
  12.  
  13.   Copyright © 1994, Frank Copeland.
  14.   This file is part of the Oberon-A Library.
  15.   See Oberon-A.doc for conditions of use and distribution.
  16.  
  17. *************************************************************************)
  18.  
  19. <* STANDARD- *> <* INITIALISE- *> <* MAIN- *> <*$ NilChk-  *>
  20.  
  21. MODULE WbConsole;
  22.  
  23. IMPORT
  24.   SYS := SYSTEM, Kernel, e := Exec, d := Dos, wb := Workbench, i := Icon;
  25.  
  26. CONST
  27.   DefWbConsole = "CON:40/12/480/150/Oberon-A Console Window";
  28.   maxD = 9;
  29.  
  30. VAR
  31.   wbConsole  : d.FileHandlePtr;
  32.  
  33. (*------------------------------------*)
  34. PROCEDURE* CloseWbConsole (VAR rc : LONGINT);
  35.  
  36. BEGIN (* CloseWbConsole *)
  37.   IF wbConsole # NIL THEN d.OldClose (wbConsole) END
  38. END CloseWbConsole;
  39.  
  40. (*------------------------------------*)
  41. PROCEDURE SetupWbConsole ();
  42.  
  43.   VAR
  44.     oldDir    : d.FileLockPtr;
  45.     oldFH     : d.FileHandlePtr;
  46.     console   : e.LSTRPTR;
  47.     diskObj   : wb.DiskObjectPtr;
  48.     toolTypes : wb.ToolTypePtr;
  49.     process   : d.ProcessPtr;
  50.     conTask   : e.MsgPortPtr;
  51.     wbMsg     : wb.WBStartupPtr;
  52.  
  53. BEGIN (* SetupWbConsole *)
  54.   IF i.base # NIL THEN (* Check for a WINDOW= tooltype *)
  55.     wbMsg := Kernel.WBenchMsg;
  56.     (* First CD to the app's directory *)
  57.     oldDir := d.CurrentDir (wbMsg.argList [0].lock);
  58.     (* Attempt to load the app's icon *)
  59.     diskObj := i.GetDiskObject (wbMsg.argList [0].name^);
  60.     IF diskObj # NIL THEN
  61.       console := i.FindToolType (diskObj.toolTypes, "WINDOW");
  62.       (* We will free diskObj AFTER we have finished with console. *)
  63.     END;
  64.     (* Back to where we started *)
  65.     oldDir := d.CurrentDir (oldDir);
  66.   ELSE
  67.     diskObj := NIL; console := NIL
  68.   END;
  69.  
  70.   (* Open the console window *)
  71.   IF console = NIL THEN console := SYS.ADR (DefWbConsole) END;
  72.   wbConsole := d.Open (console^, d.newFile);
  73.   IF diskObj # NIL THEN i.FreeDiskObject (diskObj) END;
  74.   ASSERT (wbConsole # NIL, 98);
  75.  
  76.   (* Set the console task and the Input/Output handles. *)
  77.   oldFH := d.SelectInput (wbConsole);
  78.   IF oldFH # NIL THEN d.OldClose (oldFH) END;
  79.   oldFH := d.SelectOutput (wbConsole);
  80.   IF oldFH # NIL THEN d.OldClose (oldFH) END;
  81.   conTask := wbConsole.type;
  82.   IF conTask # NIL THEN
  83.     conTask := d.SetConsoleTask (conTask)
  84.     (* I assume the old one can be ignored. The autodocs are silent
  85.     ** about this.
  86.     *)
  87.   END;
  88.  
  89.   Kernel.SetCleanup (CloseWbConsole);
  90. END SetupWbConsole;
  91.  
  92. BEGIN (* WbConsole *)
  93.   wbConsole := NIL;
  94.   IF Kernel.fromWorkbench THEN SetupWbConsole () END
  95. END WbConsole.
  96.